Avg number of beds each season
library(tidyverse)
library(lubridate)
library(ggplot2)
beds <- read_csv(here::here("raw_data/beds_by_nhs_board_of_treatment_and_specialty.csv")) %>%
janitor::clean_names()
Rows: 30448 Columns: 20
-- Column specification ----------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (11): Quarter, QuarterQF, HB, HBQF, Location, LocationQF, Specialty, SpecialtyQF, SpecialtyName, SpecialtyNameQF, PercentageOccupancyQF
dbl (5): AllStaffedBeds, TotalOccupiedBeds, AverageAvailableStaffedBeds, AverageOccupiedBeds, PercentageOccupancy
lgl (4): AllStaffedBedsQF, TotalOccupiedBedsQF, AverageAvailableStaffedBedsQF, AverageOccupiedBedsQF
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(beds)
# interested in percentage of available beds
# data is structured to show avg daily percentage of available beds per hospital (id = "hb")
# comparing against the time of year "quarter"
Cleaning
# checking column is clean
beds %>%
count(quarter)
beds_season <- beds %>%
mutate(
season = str_extract(quarter, "\\d{1}$"),
season = recode(season,
"1" = "Winter",
"2" = "Spring",
"3" = "Summer",
"4" = "Autumn"
),
year = as.numeric(str_extract(quarter, "^\\d{4}"))
)
Making Graph
beds_season %>%
group_by(season) %>%
summarise(avg_daily_beds_perc = mean(percentage_occupancy, na.rm = TRUE)) %>%
ggplot() +
aes(x = season, y = avg_daily_beds_perc, label = str_c(round(avg_daily_beds_perc), "%")) +
geom_text(nudge_y = 1, alpha = 0.8) +
geom_col(fill = "turquoise", alpha = 0.8) +
coord_cartesian(ylim = c(60, 80)) +
theme_minimal()

beds_season %>%
group_by(season, year) %>%
summarise(avg_daily_beds_perc = mean(percentage_occupancy, na.rm = TRUE)) %>%
ggplot() +
aes(x = season, y = avg_daily_beds_perc, label = str_c(round(avg_daily_beds_perc), "%")) +
geom_text(nudge_y = 1.2, alpha = 0.8) +
geom_col(fill = "turquoise", alpha = 0.8) +
coord_cartesian(ylim = c(60, 80)) +
facet_wrap(~year) +
theme_minimal()
`summarise()` has grouped output by 'season'. You can override using the `.groups` argument.

Avg number of admissions each season (can be split by simd rating)
admissions <- read_csv(here::here("raw_data/hospital_admissions_hb_simd_20220302.csv")) %>%
janitor::clean_names()
Rows: 21138 Columns: 9
-- Column specification ----------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (4): HB, HBQF, AdmissionType, AdmissionTypeQF
dbl (5): WeekEnding, SIMDQuintile, NumberAdmissions, Average20182019, PercentVariation
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(admissions)
Cleaning
admissions_date <- admissions %>%
mutate(
year = str_extract(week_ending, "^\\d{4}"),
monthday = str_extract(week_ending, "\\d{4}$"),
month = str_extract(monthday, "^\\d{2}"),
day = str_extract(monthday, "\\d{2}$"),
date = ymd(str_c(year, month, day)),
.before = 1
) %>%
select(-monthday)
head(admissions_date)
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIEF2ZyBudW1iZXIgb2YgYmVkcyBlYWNoIHNlYXNvbg0KDQpgYGB7cn0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShsdWJyaWRhdGUpDQpsaWJyYXJ5KGdncGxvdDIpDQoNCmJlZHMgPC0gcmVhZF9jc3YoaGVyZTo6aGVyZSgicmF3X2RhdGEvYmVkc19ieV9uaHNfYm9hcmRfb2ZfdHJlYXRtZW50X2FuZF9zcGVjaWFsdHkuY3N2IikpICU+JSANCiAgICAgICAgamFuaXRvcjo6Y2xlYW5fbmFtZXMoKQ0KDQpoZWFkKGJlZHMpDQoNCiMgaW50ZXJlc3RlZCBpbiBwZXJjZW50YWdlIG9mIGF2YWlsYWJsZSBiZWRzDQojIGRhdGEgaXMgc3RydWN0dXJlZCB0byBzaG93IGF2ZyBkYWlseSBwZXJjZW50YWdlIG9mIGF2YWlsYWJsZSBiZWRzIHBlciBob3NwaXRhbCAoaWQgPSAiaGIiKQ0KIyBjb21wYXJpbmcgYWdhaW5zdCB0aGUgdGltZSBvZiB5ZWFyICJxdWFydGVyIg0KYGBgDQojIyBDbGVhbmluZw0KDQpgYGB7cn0NCiMgY2hlY2tpbmcgY29sdW1uIGlzIGNsZWFuDQpiZWRzICU+JSANCiAgY291bnQocXVhcnRlcikNCg0KYmVkc19zZWFzb24gPC0gYmVkcyAlPiUgDQogIG11dGF0ZSgNCiAgICBzZWFzb24gPSBzdHJfZXh0cmFjdChxdWFydGVyLCAiXFxkezF9JCIpLA0KICAgIHNlYXNvbiA9IHJlY29kZShzZWFzb24sIA0KICAgICAgIjEiID0gIldpbnRlciIsDQogICAgICAiMiIgPSAiU3ByaW5nIiwNCiAgICAgICIzIiA9ICJTdW1tZXIiLA0KICAgICAgIjQiID0gIkF1dHVtbiINCiAgICApLA0KICAgIHllYXIgPSBhcy5udW1lcmljKHN0cl9leHRyYWN0KHF1YXJ0ZXIsICJeXFxkezR9IikpDQogICkNCmBgYA0KIyMgTWFraW5nIEdyYXBoDQoNCmBgYHtyfQ0KYmVkc19zZWFzb24gJT4lIA0KICBncm91cF9ieShzZWFzb24pICU+JSANCiAgc3VtbWFyaXNlKGF2Z19kYWlseV9iZWRzX3BlcmMgPSBtZWFuKHBlcmNlbnRhZ2Vfb2NjdXBhbmN5LCBuYS5ybSA9IFRSVUUpKSAlPiUgDQogIGdncGxvdCgpICsNCiAgYWVzKHggPSBzZWFzb24sIHkgPSBhdmdfZGFpbHlfYmVkc19wZXJjLCBsYWJlbCA9IHN0cl9jKHJvdW5kKGF2Z19kYWlseV9iZWRzX3BlcmMpLCAiJSIpKSArDQogIGdlb21fdGV4dChudWRnZV95ID0gMSwgYWxwaGEgPSAwLjgpICsNCiAgZ2VvbV9jb2woZmlsbCA9ICJ0dXJxdW9pc2UiLCBhbHBoYSA9IDAuOCkgKw0KICBjb29yZF9jYXJ0ZXNpYW4oeWxpbSA9IGMoNjAsIDgwKSkgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KYmVkc19zZWFzb24gJT4lIA0KICBncm91cF9ieShzZWFzb24sIHllYXIpICU+JSANCiAgc3VtbWFyaXNlKGF2Z19kYWlseV9iZWRzX3BlcmMgPSBtZWFuKHBlcmNlbnRhZ2Vfb2NjdXBhbmN5LCBuYS5ybSA9IFRSVUUpKSAlPiUgDQogIGdncGxvdCgpICsNCiAgYWVzKHggPSBzZWFzb24sIHkgPSBhdmdfZGFpbHlfYmVkc19wZXJjLCBsYWJlbCA9IHN0cl9jKHJvdW5kKGF2Z19kYWlseV9iZWRzX3BlcmMpLCAiJSIpKSArDQogIGdlb21fdGV4dChudWRnZV95ID0gMS4yLCBhbHBoYSA9IDAuOCkgKw0KICBnZW9tX2NvbChmaWxsID0gInR1cnF1b2lzZSIsIGFscGhhID0gMC44KSArDQogIGNvb3JkX2NhcnRlc2lhbih5bGltID0gYyg2MCwgODApKSArDQogIGZhY2V0X3dyYXAofnllYXIpICsNCiAgdGhlbWVfbWluaW1hbCgpDQpgYGANCg0KIyBBdmcgbnVtYmVyIG9mIGFkbWlzc2lvbnMgZWFjaCBzZWFzb24gKGNhbiBiZSBzcGxpdCBieSBzaW1kIHJhdGluZykNCg0KYGBge3J9DQphZG1pc3Npb25zIDwtIHJlYWRfY3N2KGhlcmU6OmhlcmUoInJhd19kYXRhL2hvc3BpdGFsX2FkbWlzc2lvbnNfaGJfc2ltZF8yMDIyMDMwMi5jc3YiKSkgJT4lIA0KICAgICAgICBqYW5pdG9yOjpjbGVhbl9uYW1lcygpDQoNCmhlYWQoYWRtaXNzaW9ucykNCmBgYA0KDQojIyBDbGVhbmluZw0KDQpgYGB7cn0NCmFkbWlzc2lvbnNfZGF0ZSA8LSBhZG1pc3Npb25zICU+JSANCiAgbXV0YXRlKA0KICAgIHllYXIgPSBzdHJfZXh0cmFjdCh3ZWVrX2VuZGluZywgIl5cXGR7NH0iKSwNCiAgICBtb250aGRheSA9IHN0cl9leHRyYWN0KHdlZWtfZW5kaW5nLCAiXFxkezR9JCIpLA0KICAgIG1vbnRoID0gc3RyX2V4dHJhY3QobW9udGhkYXksICJeXFxkezJ9IiksDQogICAgZGF5ID0gc3RyX2V4dHJhY3QobW9udGhkYXksICJcXGR7Mn0kIiksDQogICAgZGF0ZSA9IHltZChzdHJfYyh5ZWFyLCBtb250aCwgZGF5KSksDQogICAgLmJlZm9yZSA9IDENCiAgKSAlPiUgDQogIHNlbGVjdCgtbW9udGhkYXkpDQoNCmhlYWQoYWRtaXNzaW9uc19kYXRlKQ0KYGBgDQoNCmBgYHtyfQ0KbGlicmFyeSh0c2liYmxlKQ0KDQpkdXBsaWNhdGVzKGFkbWlzc2lvbnNfZGF0ZSkNCg0KIyBtYWtpbmcgZGF0ZXRpbWUgdHNpYmJsZQ0KDQphZG1pc3Npb25zX2R0IDwtIGFkbWlzc2lvbnNfZGF0ZSAlPiUgDQogIGdyb3VwX2J5KGRhdGUpICU+JSANCiAgc3VtbWFyaXNlKGF2Z19hZG1pc3Npb25zX2J5X3dlZWsgPSBtZWFuKG51bWJlcl9hZG1pc3Npb25zKSkgJT4lIA0KICBhc190c2liYmxlKCkNCg0KY2xhc3MoYWRtaXNzaW9uc19kdCRkYXRlKQ0KDQphZG1pc3Npb25zX3Bsb3RseSA8LSBhZG1pc3Npb25zX2R0ICU+JQ0KICBnZ3Bsb3QoKSArDQogIGFlcyh4ID0gZGF0ZSwgeSA9IGF2Z19hZG1pc3Npb25zX2J5X3dlZWspICsNCiAgZ2VvbV9saW5lKGNvbG9yID0gInN0ZWVsYmx1ZSIpICsNCiAgc2NhbGVfeF9kYXRlKG5hbWUgPSAiIiwgbGltaXRzID0gYyhhcy5EYXRlKCIyMDIwLTAxLTAxIiwgIiVZLSVtLSVkIiksIGFzLkRhdGUoIjIwMjItMDItMjAiLCAiJVktJW0tJWQiKSksIGRhdGVfYnJlYWtzID0gIjMgbW9udGhzIiwgDQogICAgICAgICAgICAgICBkYXRlX21pbm9yX2JyZWFrcyA9ICIxIG1vbnRoIikgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KZ2dwbG90bHkoYWRtaXNzaW9uc19wbG90bHkpDQpgYGANCg0KYGBge3J9DQoNCmBgYA0KDQo=